home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
lisp
/
kcl
/
kcl.lha
/
h
/
object.h
< prev
next >
Wrap
C/C++ Source or Header
|
1987-06-04
|
16KB
|
670 lines
/*
(c) Copyright Taiichi Yuasa and Masami Hagiya, 1984. All rights reserved.
Copying of this file is authorized to users who have executed the true and
proper "License Agreement for Kyoto Common LISP" with SIGLISP.
*/
/*
object.h
*/
/*
Some system constants.
*/
#define TRUE 1 /* boolean true value */
#define FALSE 0 /* boolean false value */
#define NBPP 4 /* number of bytes per pointer */
#define PAGESIZE 2048 /* page size in bytes */
#define PAGEWIDTH 11 /* page width */
/* log2(PAGESIZE) */
#define CHCODELIM 256 /* character code limit */
/* ASCII character set */
#define CHFONTLIM 1 /* character font limit */
#define CHBITSLIM 1 /* character bits limit */
#define CHCODEFLEN 8 /* character code field length */
#define CHFONTFLEN 0 /* character font field length */
#define CHBITSFLEN 0 /* character bits field length */
#define PHTABSIZE 512 /* number of entries */
/* in the package hash table */
#define ARANKLIM 64 /* array rank limit */
#define RTABSIZE CHCODELIM
/* read table size */
#define CBMINSIZE 64 /* contiguous block minimal size */
typedef int bool;
typedef int fixnum;
typedef float shortfloat;
typedef double longfloat;
/*
Definition of the type of LISP objects.
*/
typedef union lispunion *object;
/*
OBJect NULL value.
It should not coincide with any legal object value.
*/
#define OBJNULL ((object)NULL)
/*
Definition of each implementation type.
*/
struct fixnum_struct {
short t, m;
fixnum FIXVAL; /* fixnum value */
};
#define fix(obje) (obje)->FIX.FIXVAL
#define SMALL_FIXNUM_LIMIT 1024
struct fixnum_struct small_fixnum_table[2*SMALL_FIXNUM_LIMIT];
#define small_fixnum(i) \
(object)(small_fixnum_table+SMALL_FIXNUM_LIMIT+(i))
struct shortfloat_struct {
short t, m;
shortfloat SFVAL; /* shortfloat value */
};
#define sf(obje) (obje)->SF.SFVAL
struct longfloat_struct {
short t, m;
longfloat LFVAL; /* longfloat value */
};
#define lf(obje) (obje)->LF.LFVAL
struct bignum {
short t, m;
struct bignum *big_cdr; /* bignum cdr */
int big_car; /* bignum car */
};
struct ratio {
short t, m;
object rat_den; /* denominator */
/* must be an integer */
object rat_num; /* numerator */
/* must be an integer */
};
struct complex {
short t, m;
object cmp_real; /* real part */
/* must be a number */
object cmp_imag; /* imaginary part */
/* must be a number */
};
struct character {
short t, m;
unsigned short ch_code; /* code */
unsigned char ch_font; /* font */
unsigned char ch_bits; /* bits */
};
#ifdef MV
#endif
#ifdef AV
struct character character_table[];
#endif
#define code_char(c) (object)(character_table+(c))
#define char_code(obje) (obje)->ch.ch_code
#define char_font(obje) (obje)->ch.ch_font
#define char_bits(obje) (obje)->ch.ch_bits
enum stype { /* symbol type */
stp_ordinary, /* ordinary */
stp_constant, /* constant */
stp_special /* special */
};
#define Cnil ((object)&Cnil_body)
#define Ct ((object)&Ct_body)
struct symbol {
short t, m;
object s_dbind; /* dynamic binding */
int (*s_sfdef)(); /* special form definition */
/* This field coincides with c_car */
#define NOT_SPECIAL ((int (*)())Cnil)
#define s_fillp st_fillp
#define s_self st_self
int s_fillp; /* print name length */
char *s_self; /* print name */
/* These fields coincide with */
/* st_fillp and st_self. */
object s_gfdef; /* global function definition */
/* For a macro, */
/* its expansion function */
/* is to be stored. */
object s_plist; /* property list */
object s_hpack; /* home package */
/* Cnil for uninterned symbols */
short s_stype; /* symbol type */
/* of enum stype */
short s_mflag; /* macro flag */
};
struct symbol Cnil_body, Ct_body;
struct package {
short t, m;
object p_name; /* package name */
/* a string */
object p_nicknames; /* nicknames */
/* list of strings */
object p_shadowings; /* shadowing symbol list */
object p_uselist; /* use-list of packages */
object p_usedbylist; /* used-by-list of packages */
object *p_internal; /* hashtable for internal symbols */
object *p_external; /* hashtable for external symbols */
struct package
*p_link; /* package link */
};
/*
The values returned by intern and find_symbol.
File_symbol may return 0.
*/
#define INTERNAL 1
#define EXTERNAL 2
#define INHERITED 3
/*
All the packages are linked through p_link.
*/
struct package *pack_pointer; /* package pointer */
struct cons {
short t, m;
object c_cdr; /* cdr */
object c_car; /* car */
};
enum httest { /* hash table key test function */
htt_eq, /* eq */
htt_eql, /* eql */
htt_equal /* equal */
};
struct htent { /* hash table entry */
object hte_key; /* key */
object hte_value; /* value */
};
struct hashtable { /* hash table header */
short t, m;
struct htent
*ht_self; /* pointer to the hash table */
object ht_rhsize; /* rehash size */
object ht_rhthresh; /* rehash threshold */
int ht_nent; /* number of entries */
int ht_size; /* hash table size */
short ht_test; /* key test function */
/* of enum httest */
};
enum aelttype { /* array element type */
aet_object, /* t */
aet_ch, /* string-char */
aet_bit, /* bit */
aet_fix, /* fixnum */
aet_sf, /* short-float */
aet_lf /* long-float */
};
struct array { /* array header */
short t, m;
short a_rank; /* array rank */
/* short v_hasfillp; has-fill-pointer flag */
short a_adjustable; /* adjustable flag */
int a_dim; /* dimension */
int *a_dims; /* table of dimensions */
/* int v_fillp; fill pointer */
object *a_self; /* pointer to the array */
object a_displaced; /* displaced */
short a_elttype; /* element type */
short a_offset; /* bitvector offset */
};
struct vector { /* vector header */
short t, m;
short v_hasfillp; /* has-fill-pointer flag */
short v_adjustable; /* adjustable flag */
int v_dim; /* dimension */
int v_fillp; /* fill pointer */
/* For simple vectors, */
/* v_fillp is equal to v_dim. */
object *v_self; /* pointer to the vector */
object v_displaced; /* displaced */
short v_elttype; /* element type */
short v_offset; /* not used */
};
struct string { /* string header */
short t, m;
short st_hasfillp; /* has-fill-pointer flag */
short st_adjustable; /* adjustable flag */
int st_dim; /* dimension */
/* string length */
int st_fillp; /* fill pointer */
/* For simple strings, */
/* st_fillp is equal to st_dim. */
char *st_self; /* pointer to the string */
object st_displaced; /* displaced */
};
struct ustring {
short t, m;
short ust_hasfillp;
short ust_adjustable;
int ust_dim;
int ust_fillp;
unsigned char
*ust_self;
object ust_displaced;
};
struct bitvector { /* bitvector header */
short t, m;
short bv_hasfillp; /* has-fill-pointer flag */
short bv_adjustable; /* adjustable flag */
int bv_dim; /* dimension */
/* number of bits */
int bv_fillp; /* fill pointer */
/* For simple bitvectors, */
/* st_fillp is equal to st_dim. */
char *bv_self; /* pointer to the bitvector */
object bv_displaced; /* displaced */
short bv_elttype; /* not used */
short bv_offset; /* bitvector offset */
/* the position of the first bit */
/* in the first byte */
};
struct fixarray { /* fixnum array header */
short t, m;
short fixa_rank; /* array rank */
short fixa_adjustable;/* adjustable flag */
int fixa_dim; /* dimension */
int *fixa_dims; /* table of dimensions */
fixnum *fixa_self; /* pointer to the array */
object fixa_displaced; /* displaced */
short fixa_elttype; /* element type */
short fixa_offset; /* not used */
};
struct sfarray { /* short-float array header */
short t, m;
short sfa_rank; /* array rank */
short sfa_adjustable; /* adjustable flag */
int sfa_dim; /* dimension */
int *sfa_dims; /* table of dimensions */
shortfloat
*sfa_self; /* pointer to the array */
object sfa_displaced; /* displaced */
short sfa_elttype; /* element type */
short sfa_offset; /* not used */
};
struct lfarray { /* long-float array header */
short t, m;
short lfa_rank; /* array rank */
short lfa_adjustable; /* adjustable flag */
int lfa_dim; /* dimension */
int *lfa_dims; /* table of dimensions */
longfloat
*lfa_self; /* pointer to the array */
object lfa_displaced; /* displaced */
short lfa_elttype; /* element type */
short lfa_offset; /* not used */
};
struct structure { /* structure header */
short t, m;
object str_name; /* structure name */
object *str_self; /* structure self */
int str_length; /* structure length */
};
enum smmode { /* stream mode */
smm_input, /* input */
smm_output, /* output */
smm_io, /* input-output */
smm_probe, /* probe */
smm_synonym, /* synonym */
smm_broadcast, /* broadcast */
smm_concatenated, /* concatenated */
smm_two_way, /* two way */
smm_echo, /* echo */
smm_string_input, /* string input */
smm_string_output /* string output */
};
struct stream {
short t, m;
FILE *sm_fp; /* file pointer */
object sm_object0; /* some object */
object sm_object1; /* some object */
int sm_int0; /* some int */
int sm_int1; /* some int */
short sm_mode; /* stream mode */
/* of enum smmode */
};
#ifdef BSD
#define BASEFF (char *)0xffffffff
#endif
#ifdef ATT
#define BASEFF (unsigned char *)0xffffffff
#endif
#ifdef E15
#define BASEFF (unsigned char *)0xffffffff
#endif
#ifdef MV
#endif
struct random {
short t, m;
unsigned rnd_value; /* random state value */
};
enum chattrib { /* character attribute */
cat_whitespace, /* whitespace */
cat_terminating, /* terminating macro */
cat_non_terminating, /* non-terminating macro */
cat_single_escape, /* single-escape */
cat_multiple_escape, /* multiple-escape */
cat_constituent /* constituent */
};
struct rtent { /* read table entry */
enum chattrib rte_chattrib; /* character attribute */
object rte_macro; /* macro function */
object *rte_dtab; /* pointer to the */
/* dispatch table */
/* NULL for */
/* non-dispatching */
/* macro character, or */
/* non-macro character */
};
struct readtable { /* read table */
short t, m;
struct rtent *rt_self; /* read table itself */
};
struct pathname {
short t, m;
object pn_host; /* host */
object pn_device; /* device */
object pn_directory; /* directory */
object pn_name; /* name */
object pn_type; /* type */
object pn_version; /* version */
};
struct cfun { /* compiled function header */
short t, m;
object cf_name; /* compiled function name */
int (*cf_self)(); /* entry address */
object cf_data; /* data the function uses */
/* for GBC */
char *cf_start; /* start address of the code */
int cf_size; /* code size */
};
struct cclosure { /* compiled closure header */
short t, m;
object cc_name; /* compiled closure name */
int (*cc_self)(); /* entry address */
object cc_env; /* environment */
object cc_data; /* data the closure uses */
/* for GBC */
char *cc_start; /* start address of the code */
int cc_size; /* code size */
object *cc_turbo; /* turbo charger */
};
struct spice {
short t, m;
int spc_dummy;
};
/*
dummy type
*/
struct dummy {
short t, m;
};
/*
Definition of lispunion.
*/
union lispunion {
struct fixnum_struct
FIX; /* fixnum */
struct bignum big; /* bignum */
struct ratio rat; /* ratio */
struct shortfloat_struct
SF; /* short floating-point number */
struct longfloat_struct
LF; /* long floating-point number */
struct complex cmp; /* complex number */
struct character
ch; /* character */
struct symbol s; /* symbol */
struct package p; /* package */
struct cons c; /* cons */
struct hashtable
ht; /* hash table */
struct array a; /* array */
struct vector v; /* vector */
struct string st; /* string */
struct ustring ust;
struct bitvector
bv; /* bit-vector */
struct structure
str; /* structure */
struct stream sm; /* stream */
struct random rnd; /* random-states */
struct readtable
rt; /* read table */
struct pathname pn; /* path name */
struct cfun cf; /* compiled function */
struct cclosure cc; /* compiled closure */
struct spice spc; /* spice */
struct dummy d; /* dummy */
struct fixarray fixa; /* fixnum array */
struct sfarray sfa; /* short-float array */
struct lfarray lfa; /* long-float array */
};
/*
The struct of free lists.
*/
struct freelist {
short t, m;
object f_link;
};
#define FREE (-1) /* free object */
/*
Implementation types.
*/
enum type {
t_cons = 0,
t_start = t_cons,
t_fixnum,
t_bignum,
t_ratio,
t_shortfloat,
t_longfloat,
t_complex,
t_character,
t_symbol,
t_package,
/* t_cons, */
t_hashtable,
t_array,
t_vector,
t_string,
t_bitvector,
t_structure,
t_stream,
t_random,
t_readtable,
t_pathname,
t_cfun,
t_cclosure,
t_spice,
t_end,
t_contiguous, /* contiguous block */
t_relocatable, /* relocatable block */
t_other /* other */
};
/*
Type map.
enum type type_map[MAXPAGE];
*/
char type_map[MAXPAGE];
/*
Type_of.
*/
#define type_of(obje) ((enum type)(((object)(obje))->d.t))
/*
Storage manager for each type.
*/
struct typemanager {
enum type
tm_type; /* type */
int tm_size; /* element size in bytes */
int tm_nppage; /* number per page */
object tm_free; /* free list */
/* Note that it is of type object. */
int tm_nfree; /* number of free elements */
int tm_nused; /* number of elements used */
int tm_npage; /* number of pages */
int tm_maxpage; /* maximum number of pages */
char *tm_name; /* type name */
int tm_gbccount; /* GBC count */
};
/*
The table of type managers.
*/
struct typemanager tm_table[(int)t_end];
#define tm_of(t) (&(tm_table[(int)tm_table[(int)(t)].tm_type]))
/*
Contiguous block header.
*/
struct contblock { /* contiguous block header */
int cb_size; /* size in bytes */
struct contblock
*cb_link; /* contiguous block link */
};
/*
The pointer to the contiguous blocks.
*/
struct contblock *cb_pointer; /* contblock pointer */
/*
Variables for memory management.
*/
int ncb; /* number of contblocks */
int ncbpage; /* number of contblock pages */
int maxcbpage; /* maximum number of contblock pages */
int cbgbccount; /* contblock gbc count */
int holepage; /* hole pages */
int nrbpage; /* number of relblock pages */
int rbgbccount; /* relblock gbc count */
char *rb_start; /* relblock start */
char *rb_end; /* relblock end */
char *rb_limit; /* relblock limit */
char *rb_pointer; /* relblock pointer */
char *rb_start1; /* relblock start in copy space */
char *rb_pointer1; /* relblock pointer in copy space */
char *heap_end; /* heap end */
char *core_end; /* core end */
#define HOLEPAGE 128
#ifdef ATT
#undef HOLEPAGE
#define HOLEPAGE 32
#endif
#ifdef E15
#undef HOLEPAGE
#define HOLEPAGE 32
#endif
#define INIT_HOLEPAGE 150
#define INIT_NRBPAGE 50
#define RB_GETA 512
/*
Endp macro.
*/
/*
#define endp(obje) ((enum type)((endp_temp = (obje))->d.t) == t_cons ? \
FALSE : endp_temp == Cnil ? TRUE : \
(bool)FEwrong_type_argument(Slist, endp_temp))
object endp_temp;
*/
#define endp(obje) endp1(obje)
#ifdef AV
#define STATIC register
#endif
#ifdef MV
#endif
#define TIME_ZONE (-9)
int FIXtemp;
#define isUpper(xxx) (((xxx)&0200) == 0 && isupper(xxx))
#define isLower(xxx) (((xxx)&0200) == 0 && islower(xxx))
#define isDigit(xxx) (((xxx)&0200) == 0 && isdigit(xxx))